;;;Solving the instant insanity puzzle by depth first search.  
;;;Solution is (SEARCH P0) and SEARCH is found in SEARCH.LSP
;;;Alternate representation is in INSANB.LSP

(DEFPROP INSANI (LOSE TER SUCCESSORS ORLIS NTH CYCLES UPTO PRUP SUBLIS) INSANBFNS)
(DEFPROP INSANI (P0 PUZZ1 PUZZ2 PUZZ3 PUZZ4 PUZZ ) CONSTANTS)
(DEFPROP INSANI (MKPUZZ2 MKPUZZ3 MKPUZZ3A MKPUZZ4 MKPUZZ4A MKPUZZ ) MKPUZZFNS)

(DEFUN LOSE (P) (ORLIS (FUNCTION (LAMBDA (U) (AND (NOT (NULL U))(MEMQ (CAR U) (CDR U))))) P) )

(DEFUN TER (P) (EQ (LENGTH (CAR P)) 4))

(DEFUN SUCCESSORS (P) 
  (MAPCAR (FUNCTION (LAMBDA (X) (MAPCAR (FUNCTION (LAMBDA (Y Z) (CONS Z Y))) P X))) 
	  (NTH PUZZ (ADD1 (LENGTH (CAR P)))) ) )

(DEFPROP ORLIS
 (LAMBDA(PRED U)
  (AND (NOT (NULL U)) (OR (PRED (CAR U)) (ORLIS PRED (CDR U)))))
EXPR)

(DEFUN NTH (U N) (COND ((EQ N 1) (CAR U)) (T (NTH (CDR U) (SUB1 N)))))

(DEFUN CYCLES (U) (MAPLIST (FUNCTION (LAMBDA (V) (APPEND V (UPTO U V)))) U))

(DEFUN UPTO (U V) (COND ((EQ V U) NIL)(T (CONS (CAR U) (UPTO (CDR U) V)))))

(DEFUN SUBLIS (Z A) 
  (COND ((ATOM Z)((LAMBDA (ZZ) (COND ((NULL ZZ) Z) (T (CDR ZZ))))(ASSOC Z A)))
	(T (CONS (SUBLIS (CAR Z) A) (SUBLIS (CDR Z) A)))))

(DEFUN PRUP (U V) (COND ((NULL U) NIL) (T (CONS (CONS (CAR U) (CAR V)) (PRUP (CDR U) (CDR V))))))

(SSTATUS PUNT NIL)

(SETQ P0 '(NIL NIL NIL NIL))

(SETQ PUZZ1 '((G B B W R G) (G G B G W R) (G W W R B R) (G G R B W W)) )

(DEFUN MKPUZZ2 ()
  (APPEND (CYCLES '(2 3 4 5)) (CYCLES '(2 5 4 3)) (CYCLES '(1 2 6 4)) 
          (CYCLES '(1 4 6 2)) (CYCLES '(1 3 6 5)) (CYCLES '(1 5 6 3)) ) )

(DEFPROP PUZZ2 
  ((2 3 4 5) (3 4 5 2) (4 5 2 3) (5 2 3 4) (2 5 4 3) (5 4 3 2) (4 3 2 5) (3 2 5 4)  
   (1 2 6 4) (2 6 4 1) (6 4 1 2) (4 1 2 6) (1 4 6 2) (4 6 2 1) (6 2 1 4) (2 1 4 6)  
   (1 3 6 5) (3 6 5 1) (6 5 1 3) (5 1 3 6) (1 5 6 3) (5 6 3 1) (6 3 1 5) (3 1 5 6)) 
PUZZ2)

(DEFUN MKPUZZ3 ()
  (MAPCAR (FUNCTION (LAMBDA (V) (MAPCAR (FUNCTION CONS) '(1 2 3 4 5 6) V))) PUZZ1))

(DEFUN MKPUZZ3A ()
  (MAPCAR (FUNCTION (LAMBDA (V) (PRUP '(1 2 3 4 5 6) V) )) PUZZ1))

(DEFPROP PUZZ3
    (((1 . G) (2 . B) (3 . B) (4 . W) (5 . R) (6 . G))  
     ((1 . G) (2 . G) (3 . B) (4 . G) (5 . W) (6 . R))  
     ((1 . G) (2 . W) (3 . W) (4 . R) (5 . B) (6 . R))  
     ((1 . G) (2 . G) (3 . R) (4 . B) (5 . W) (6 . W))) 
PUZZ3)

(DEFUN MKPUZZ4 ()
  (MAPCAR (FUNCTION 
          (LAMBDA (S) 
	    (MAPCAR (FUNCTION 
		      (LAMBDA (U) 
			(MAPCAR (FUNCTION (LAMBDA (X) (CDR (ASSOC X S)))) U)))
		     PUZZ2)))
          PUZZ3) )

(DEFUN MKPUZZ4A ()
  (MAPCAR (FUNCTION (LAMBDA (S) (SUBLIS PUZZ2 S))) PUZZ3) )

(DEFPROP PUZZ4
  (((B B W R) (B W R B) (W R B B) (R B B W) (B R W B) (R W B B) (W B B R) (B B R W)  
    (G B G W) (B G W G) (G W G B) (W G B G) (G W G B) (W G B G) (G B G W) (B G W G)  
    (G B G R) (B G R G) (G R G B) (R G B G) (G R G B) (R G B G) (G B G R) (B G R G))  
   ((G B G W) (B G W G) (G W G B) (W G B G) (G W G B) (W G B G) (G B G W) (B G W G)  
    (G G R G) (G R G G) (R G G G) (G G G R) (G G R G) (G R G G) (R G G G) (G G G R)  
    (G B R W) (B R W G) (R W G B) (W G B R) (G W R B) (W R B G) (R B G W) (B G W R))  
   ((W W R B) (W R B W) (R B W W) (B W W R) (W B R W) (B R W W) (R W W B) (W W B R)  
    (G W R R) (W R R G) (R R G W) (R G W R) (G R R W) (R R W G) (R W G R) (W G R R)  
    (G W R B) (W R B G) (R B G W) (B G W R) (G B R W) (B R W G) (R W G B) (W G B R))  
   ((G R B W) (R B W G) (B W G R) (W G R B) (G W B R) (W B R G) (B R G W) (R G W B)  
    (G G W B) (G W B G) (W B G G) (B G G W) (G B W G) (B W G G) (W G G B) (G G B W)  
    (G R W W) (R W W G) (W W G R) (W G R W) (G W W R) (W W R G) (W R G W) (R G W W))) 
PUZZ4)

(DEFUN MKPUZZ ()
           (CONS (LIST (NTH (CAR PUZZ4)  1.) 
                       (NTH (CAR PUZZ4)  9.)
                       (NTH (CAR PUZZ4) 17.))
                 (CDR PUZZ4)))

(DEFPROP PUZZ
  (((B B W R) (G B G W) (G B G R))  
   ((G B G W) (B G W G) (G W G B) (W G B G) (G W G B) (W G B G) (G B G W) (B G W G)  
    (G G R G) (G R G G) (R G G G) (G G G R) (G G R G) (G R G G) (R G G G) (G G G R)  
    (G B R W) (B R W G) (R W G B) (W G B R) (G W R B) (W R B G) (R B G W) (B G W R))  
   ((W W R B) (W R B W) (R B W W) (B W W R) (W B R W) (B R W W) (R W W B) (W W B R)  
    (G W R R) (W R R G) (R R G W) (R G W R) (G R R W) (R R W G) (R W G R) (W G R R)  
    (G W R B) (W R B G) (R B G W) (B G W R) (G B R W) (B R W G) (R W G B) (W G B R))  
   ((G R B W) (R B W G) (B W G R) (W G R B) (G W B R) (W B R G) (B R G W) (R G W B)  
    (G G W B) (G W B G) (W B G G) (B G G W) (G B W G) (B W G G) (W G G B) (G G B W)  
    (G R W W) (R W W G) (W W G R) (W G R W) (G W W R) (W W R G) (W R G W) (R G W W))) 
PUZZ)

;;;(SEARCH P0) 2 SECS
;;;((G W R B) (R W G B) (B R G W) (W B G R)) 
;;;(ALLSOL P0) 10 SECS
;;;(((G W R B) (G R W B) (B R G W) (W G B R)) 
;;; ((G W R B) (R W G B) (B R G W) (W B G R)) 
;;; ((G W R B) (R W G B) (B R G W) (W B G R)))